home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TURBOPASCAL WIN / WINDEMOS.PAK / FDLGDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-08  |  4KB  |  162 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Demo program                                 }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. { Demo of FILEDLGS unit }
  10.  
  11. program FDlgDemo;
  12.  
  13. {$S-}
  14. {$R FDLGDEMO.RES}
  15.  
  16. uses WinTypes, WinProcs, WinDos, Strings, FileDlgs;
  17.  
  18. const
  19.   AppName = 'FDlgDemo';
  20.  
  21. const
  22.   id_New    = 100;
  23.   id_Open   = 101;
  24.   id_Save   = 102;
  25.   id_SaveAs = 103;
  26.   id_Exit   = 199;
  27.   id_About  = 200;
  28.  
  29. const
  30.   GFileName: array[0..fsPathName] of Char = '';
  31.  
  32. function About(Dialog: HWnd; Message, WParam: Word;
  33.   LParam: Longint): Bool; export;
  34. begin
  35.   About := True;
  36.   case Message of
  37.     wm_InitDialog:
  38.       Exit;
  39.     wm_Command:
  40.       if (WParam = id_Ok) or (WParam = id_Cancel) then
  41.       begin
  42.         EndDialog(Dialog, 1);
  43.         Exit;
  44.       end;
  45.   end;
  46.   About := False;
  47. end;
  48.  
  49. function MainWndProc(Window: HWnd; Message, WParam: Word;
  50.   LParam: Longint): Longint; export;
  51. var
  52.   AboutProc: TFarProc;
  53.   DC: HDC;
  54.   PS: TPaintStruct;
  55.   P: PChar;
  56.   S: array[0..127] of Char;
  57. begin
  58.   MainWndProc := 0;
  59.   case Message of
  60.     wm_Command:
  61.       case WParam of
  62.         id_Open:
  63.           begin
  64.             DoFileOpen(Window, StrCopy(GFileName, '*.pas'));
  65.             InvalidateRect(Window, nil, True);
  66.             Exit;
  67.           end;
  68.         id_Save, id_SaveAs:
  69.           begin
  70.             DoFileSave(Window, GFileName);
  71.             InvalidateRect(Window, nil, True);
  72.             Exit;
  73.           end;
  74.         id_Exit:
  75.           begin
  76.             SendMessage(Window, wm_Close, 0, 0);
  77.             Exit;
  78.           end;
  79.         id_About:
  80.           begin
  81.             AboutProc := MakeProcInstance(@About, HInstance);
  82.             DialogBox(HInstance, 'AboutBox', Window, AboutProc);
  83.             FreeProcInstance(AboutProc);
  84.             Exit;
  85.           end;
  86.       end;
  87.     wm_Paint:
  88.       begin
  89.         DC := BeginPaint(Window, PS);
  90.         P := @GFileName;
  91.         TextOut(DC, 10, 10, S, WVSPrintF(S, 'File name:  %s', P));
  92.         EndPaint(Window, PS);
  93.       end;
  94.     wm_Destroy:
  95.       begin
  96.         PostQuitMessage(0);
  97.         Exit;
  98.       end;
  99.   end;
  100.   MainWndProc := DefWindowProc(Window, Message, WParam, LParam);
  101. end;
  102.  
  103. procedure InitApplication;
  104. const
  105.   WindowClass: TWndClass = (
  106.     style: 0;
  107.     lpfnWndProc: @MainWndProc;
  108.     cbClsExtra: 0;
  109.     cbWndExtra: 0;
  110.     hInstance: 0;
  111.     hIcon: 0;
  112.     hCursor: 0;
  113.     hbrBackground: 0;
  114.     lpszMenuName: AppName;
  115.     lpszClassName: AppName);
  116. begin
  117.   WindowClass.hInstance := HInstance;
  118.   WindowClass.hIcon := LoadIcon(0, idi_Application);
  119.   WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  120.   WindowClass.hbrBackground := GetStockObject(white_Brush);
  121.   if not RegisterClass(WindowClass) then Halt(1);
  122. end;
  123.  
  124. procedure InitInstance;
  125. var
  126.   Window: HWnd;
  127. begin
  128.   Window := CreateWindow(
  129.     AppName,
  130.     'File Dialogs Demo',
  131.     ws_OverlappedWindow,
  132.     cw_UseDefault,
  133.     cw_UseDefault,
  134.     cw_UseDefault,
  135.     cw_UseDefault,
  136.     0,
  137.     0,
  138.     HInstance,
  139.     nil);
  140.   if Window = 0 then Halt(1);
  141.   ShowWindow(Window, CmdShow);
  142.   UpdateWindow(Window);
  143. end;
  144.  
  145. procedure WinMain;
  146. var
  147.   Message: TMsg;
  148. begin
  149.   if HPrevInst = 0 then InitApplication;
  150.   InitInstance;
  151.   while GetMessage(Message, 0, 0, 0) do
  152.   begin
  153.     TranslateMessage(Message);
  154.     DispatchMessage(Message);
  155.   end;
  156.   Halt(Message.wParam);
  157. end;
  158.  
  159. begin
  160.   WinMain;
  161. end.
  162.